Varios Español/Varios Español.iso/DBASE5/SAMPLES.ZIP/FACTURAS.PRG

Text File | 1994-10-12 | 11KB | 364 lines

******************************************************************************
* PROGRAM NAME: INVOICES.PRG
*               SAMPLE CUSTOM REPORT - INVOICES
*               GENERATES INVOICES & UPDATES ACCT_REC.DBF
*               SAMPLE BUSINESS APPLICATION
* LAST CHANGED: 09/25/89 09:26AM
* WRITTEN BY:   Borland International Inc.
******************************************************************************
*              Logic and some variable names modeled after reports generator
******************************************************************************
*
*DO WHILE .NOT. PRINTSTATUS()
 *  DO ErrorMsg WITH "Impresora no preparada. Pulse Esc para cancelar"
  * RETURN
*ENDDO

CLEAR
inv_month = 0

   ?? CHR(7)
   inv_month = MONTH(DATE())-1
   @ 10, 8 CLEAR TO 14,72
   @ 12,5 SAY "¿Procesar facturas del mes (1-12, 0 para Abandonar)?" ;
          GET inv_month PICTURE "99" RANGE 0,12
   READ
    IF Inv_Month=0 .or. lastkey()=27
        CLEAR
        RETURN
    ENDIF
set talk off
* Open database files and choose active indexes
SELECT 1
USE Pedidos   ORDER Pedido
USE Cli       ORDER Cod_cli IN 2
USE Mov_ctas  ORDER Cod_cli IN 3
USE Articulo  ORDER Cod_art IN 4
* Relate database files and activate the relation
SET RELATION TO Cod_cli INTO Cli, Cod_cli INTO Mov_ctas, Cod_art INTO Articulo
GO TOP

* If user presses Esc during printing, exit
ON ESCAPE DO Stop_rpt

* Process errors
* ON ERROR DO Errormsg

* Set up environment
SET SPACE OFF
_plineno  =  0
_peject   = "NONE"
_pageno   = 1

* Initialize variables
continu_on  = .T.               && Continue printing flag - set by Esc to .F.
complete = .F.
on_pg_line = 0                  && Line at which ON PAGE works
STORE 0  TO amt_of_bil, amt_of_cur, inv_amount, oldbalance
STORE 0  TO inv_count, ord_count, grand_tot, tot_price
STORE "" TO invoice_no, mcust_id, today, this_year, this_month
today      = DTOC(DATE())
this_year  = RIGHT(today,2)
this_month = LEFT(today,2)

* Calculate line no. to break page on
on_pg_line = INT(_plength - 6)  && Height minus footer and margin

* Set up line number where page break procedure executes
ON PAGE AT LINE on_pg_line DO Page_brk

SET CONSOLE off
SET PRINTER on
*================================ Begin Print Job ============================
PRINTJOB
   * ======= File loop - process records in index order to end of file =======
   *                     or until user presses Esc (continu_on = .F.)
   * Process all uninvoiced records for a particular customer
   SCAN FOR .NOT. facturado .AND. inv_month = MONTH(Fech_trans) ;
    WHILE continu_on
      mcust_id = cust_id
      DO Pg_head      && Print standard page heading
      DO Inv_head     && Print invoice heading
      complete = .F.  && Flag customer's invoices not completely processed
      * Print orders for this customer
      SCAN FOR .NOT. Facturado .AND. inv_month = MONTH(Fech_trans) ;
       WHILE Cod_cli = mCod_cli .AND. continu_on
     DO Detail
      ENDSCAN
      complete = .T.  && Flag customer's invoices are completely processed
      SKIP -1         && Return to last record for customer
      DO Inv_calc     && Print invoice total for last customer
      EJECT PAGE      && Print invoice footer - Inv_foot called by ON PAGE
      DO Updat_ar     && Update Acct_rec database file with processed data
      DO Reinit       && Re-initialize summary variables
   ENDSCAN
   IF continu_on
      * End of file - User did not press Esc to stop printing
      message = "Finalizado el proceso e impresión de facturas del mes " ;
        + STR(inv_month,2)
   ELSE
      * Not EOF - User pressed Esc to stop printing
      message = "Facturas NO FINALIZADAS. Detenido por el usuario a las " + TIME()
   ENDIF
   DO Rpt_end WITH message
   ON PAGE
ENDPRINTJOB
*============================= End Print Job =================================
EJECT PAGE
ON PAGE
SET CONSOLE on
SET PRINTER off
CLEAR

   ?? CHR(7)
   @ 10,12 SAY "COPIANDO pedidos procesados, espere por favor...          "
   @ 12,10 SAY SPACE(61)
   @ 13,10 SAY SPACE(63)

   CLOSE DATABASES
   * Create an archive database file for processed orders.
   * Records will be copied to it, then erased from Orders.
   IF .NOT. FILE("Archiv_o.dbf")
      USE Pedidos
      COPY STRUCTURE TO Archiv_o
   ENDIF
   USE Archiv_o

   APPEND FROM Pedidos FOR Facturado

   *-- Remove the archived records from Orders
   USE Pedidos EXCLUSIVE
   SET TALK on
   DELETE ALL FOR Facturado
   @ 10,10 SAY "ELIMINANDO pedidos procesados, espere por favor...   "
   PACK
   SET TALK off
ON ESCAPE
ON ERROR
CLOSE ALL
SET PROCEDURE TO
SET CONSOLE ON
IF FILE("ARCHIV_O.DBF")
    DELE FILE ARCHIV_O.DBF
ENDIF
CLEAR
RETURN
********************* END OF MAIN REPORT PROCEDURE ***************************

* UTILITY PROCEDURES


PROCEDURE Detail
   * Imprimir apartado de detalle del informe
   ?? Fech_trans       AT 0,
   ?? Cod_art          AT 10,
   ?? Articulo->Nom_art AT 21,
   ?? Can_art         AT 53 PICTURE "999",
   ?? Articulo->Precio     AT 58 PICTURE "9,999,999",
   * Extend price
   tot_price  = ROUND(Can_art * Articulo->Precio,2)
   ?? tot_price        AT 70 PICTURE "9,999,999"
   ?
   * Accumulate total amount of current invoice
   Imp_fac = Imp_fac + tot_price
   * Accumulate number of orders processed
   ord_count  = ord_count + 1
   * Update the posted flag "invoiced" to .T. in Orders dbf for this order
   REPLACE Facturado WITH .T.
RETURN


PROCEDURE Inv_calc
   * Print calculated summary data on details at cust_id break
   Imp_cta = Imp_fac + Balanc_ant
   ?? "----------" AT 69
   ?
   ?? "IMPORTE DE FACTURA" AT 0,
   ?? "Ptas" AT 64,
   ?? Imp_fac PICTURE "99,999,999" AT 69
   ?
   IF Balanc_ant <> 0
      ?? "----------" AT 69
      ? "+ BALANCE ANTERIOR"
      ?? Balanc_ant PICTURE "99,999,999" AT 69,
      ?
   ENDIF
   ?? "==========" AT 69
   ?
   ?? "CANTIDAD TOTAL DEBIDA" STYLE "B" AT 0,
   ?? "Ptas" STYLE "B" AT 64,
   ?? Imp_cta PICTURE "99,999,999" STYLE "B" AT 69
   ?
   ?? "==========" AT 69
   * Acumular cuentas totales para fin de informe
   grand_tot = grand_tot + Imp_cta
   ?
   ?
RETURN

PROCEDURE Inv_foot
   * Imprimir pie de página de la factura
   ?
   ? "FORMA DE PAGO: " AT 27,Cli->F_pago
   ?
   ? Mov_ctas->Notas  AT 18
   * Comenzar nueva pßgina
   EJECT PAGE
RETURN

PROCEDURE Inv_head
   * Codigo nuevo número de factura
   Num_fac = Cod_cli + this_year + this_month
   * Incrementar contador de facturas
   inv_count  = inv_count + 1
   ?
   ?? "FACTURA Nº: " STYLE "B" AT 0,
   ?? Num_fac STYLE "B" FUNCTION "T" PICTURE "XXXXXXXXXX" ,
   ?? DATE() AT 69
   ?
   ?
   ?? "Cliente Nº: " AT 0,
   ?? Cod_cli FUNCTION "T" PICTURE "XXXXXX"
   ?
   ?
   ?? Cli->Cliente AT 0
   ?
   ?? Cli->Direccion1 AT 0, Cli->Direccion2 AT LEN(TRIM(Cli->Direccion1))+2
   ?
   ?? Cli->Ciudad PICTURE "@T XXXXXXXXXXXXXXXXXXXX" AT 0,
   ?? ", ",
   ?? Cli->Provincia," ",
   ?? Cli->Cod_post
   ?
   ?? "ATENCION: " AT 0 ,
   ?? Cli->Contacto PICTURE "@T XXXXXXXXXXXXXXXXXXXX","  ",
   ?? Cli->Tel_cont
   ?
   ?  REPLICATE(CHR(205),80)        && Dibujar línea doble horizontal de 80    ?
   ?
   ?
   ?? "ESTADO ANTERIOR:" STYLE "BU" AT 0
   ?
   ?? "FACTURA Nº:" AT 4, Mov_ctas->Num_ultfac AT 15
   ?? "FECHA:" AT 31, Mov_ctas->Fch_ultfac AT 37
   ?
   ?? "IMPORTE Pt" AT 4, Mov_ctas->Imp_ultcta PICTURE "99,999,999" AT 15
   ?
   ?? "PAGADO  Pt" AT 4, Mov_ctas->Imp_ultpag PICTURE "99,999,999" AT 15
   ?
   ?? "----------" AT 15
   ?
   ?? "BALANCE t" AT 4
   Balanc_ant = Mov_ctas->Balanc_ant
   ?? Balanc_ant PICTURE "99,999,999" AT 15
   ?
   ?
   ?? "ESTADO ACTUAL:" STYLE "BU" AT 0
   ?  REPLICATE(CHR(196),80)        && Dibujar línea doble horizontal de 80    ?  "Pedido"    AT 0
   ?  "Fecha"              AT 0
   ?? "Nº artí."     AT 10
   ?? "Descripcion" AT 21
   ?? "Cant."              AT 53
   ?? "Precio"             AT 61
   ?? "Importe"            AT 70
   ?  REPLICATE(CHR(196),80)        && Dibujar línea doble horizontal de 80    ?
RETURN

PROCEDURE Page_brk
   * Page break logic - occurs when report detail line = on_pg_line
   DO Inv_foot
   * Print heading if customer's invoices were not completed on prior page
   IF .NOT. EOF() .AND. .NOT. complete
      DO Pg_head
   ENDIF
RETURN

PROCEDURE Pg_head
   * Print information at top of each invoice page
   ?
   ?  "Página " ,
   ?? _pageno PICTURE "999"
   ?
   ?
   ?  "A-T  INDUSTRIAS DEL MUEBLE" STYLE "B"   AT 27
   ?
   DEFINE BOX FROM 34 TO 45 HEIGHT 3 SINGLE
   ?
   ?? "FACTURA" STYLE "B" AT 36
   ?
   ?
   ?  REPLICATE(CHR(205),80)        && Draw double line 80 characters wide
   ?
RETURN

PROCEDURE Reinit
   * Re-initialize summary/calculation variables at customer breaks
   STORE 0 TO Imp_fac, inv_amount
   _pageno = 1
RETURN

PROCEDURE Rpt_end
   PARAMETERS message
   * Print end-of-report summary data
   ?
   ?
   ?  "A-T  INDUSTRIAS DEL MUEBLE"    AT 27
   ?  "=========================="    AT 27
   ?
   ?  "PAGINA RESUMEN"  AT 33
   ?
   inv_date = CTOD(STR(inv_month,2)+RIGHT(DTOC(DATE()),6))
   ?  "DEL MES DE " AT 29, UPPER(CMONTH(inv_date))
   ?
   ?
   ?
   ?  REPLICATE(CHR(205),80)        && Draw double line 80 characters wide
   ?  DATE() AT 0 ,
   ?? TIME() AT 69
   ?  REPLICATE(CHR(205),80)        && Draw double line 80 characters wide
   ?
   ?
   ?
   ?
   ?? "===========" AT 67,
   ?
   ?? "TOTAL " AT 0,
   ?? inv_count PICTURE "999",
   ?? " facturas " AT 21,
   ?? "y ", ord_count PICTURE "9,999",
   ?? " pedidos:",
   ?? "Pts" AT 64,
   ?? grand_tot PICTURE "99,999,999" ,
   ?
   ?? "===========" AT 67
   ?
   ?
   ?
   ?  message AT 6
   ?
RETURN

PROCEDURE Stop_rpt
   continu_on = .F.   && Set stop printing flag to .F. when user presses Esc
RETURN

PROCEDURE Updat_ar
   * Actualizar registro del fichero relacionado Mov_ctas para este cliente con los datos
   * procesados/calculados durante la facturación de los datos anteriores
   SELECT Mov_ctas
   IF Pedidos->Cod_cli <> Cod_cli
      * Si el cliente nunca había sido facturado antes, crear un registro de cliente
      APPEND BLANK
      REPLACE Cod_cli WITH Pedidos->Cod_cli
   ENDIF
   REPLACE Num_ultfac WITH Num_fac, Fch_ultfac WITH Fecha_fac, ;
       Imp_ultpag WITH Imp_pag, Imp_ultcta WITH Imp_fac, ;
       Balanc_ant WITH Imp_ultcta - Imp_ultpag, Comentario WITH "", ;
       Notas WITH "", Num_fac WITH m->Num_fac, ;
       Fecha_fac WITH DATE(), Imp_fac WITH m->Imp_fac, ;
       Imp_cta WITH m->Imp_cta
   SELECT Pedidos
RETURN

****************************************** END OF FACTURAS.PRG ***************